home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / namespace.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  41.4 KB  |  1,081 lines  |  [TEXT/ALFA]
  1. # Functionality covered: this file contains a collection of tests for the
  2. # procedures in tclNamesp.c that implement Tcl's basic support for
  3. # namespaces. Other namespace-related tests appear in variable.test.
  4. #
  5. # Sourcing this file into Tcl runs the tests and generates output for
  6. # errors. No output means no errors were found.
  7. #
  8. # Copyright (c) 1997 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # SCCS: @(#) namespace.test 1.15 97/07/30 15:26:42
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. # Clear out any namespaces called test_ns_*
  18. catch {eval namespace delete [namespace children :: test_ns_*]}
  19.  
  20. test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
  21.     namespace children :: test_ns_*
  22. } {}
  23.  
  24. catch {unset l}
  25. test namespace-2.1 {Tcl_GetCurrentNamespace} {
  26.     list [namespace current] [namespace eval {} {namespace current}] \
  27.         [namespace eval {} {namespace current}]
  28. } {:: :: ::}
  29. test namespace-2.2 {Tcl_GetCurrentNamespace} {
  30.     set l {}
  31.     lappend l [namespace current]
  32.     namespace eval test_ns_1 {
  33.         lappend l [namespace current]
  34.         namespace eval foo {
  35.             lappend l [namespace current]
  36.         }
  37.     }
  38.     lappend l [namespace current]
  39.     set l
  40. } {:: ::test_ns_1 ::test_ns_1::foo ::}
  41.  
  42. test namespace-3.1 {Tcl_GetGlobalNamespace} {
  43.     namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
  44.     # namespace children uses Tcl_GetGlobalNamespace 
  45.     namespace eval test_ns_1 {namespace children foo b*}
  46. } {::test_ns_1::foo::bar}
  47.  
  48. test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
  49.     namespace eval test_ns_1 {
  50.         variable v 123
  51.         proc p {} {
  52.             variable v
  53.             return $v
  54.         }
  55.     }
  56.     test_ns_1::p    ;# does Tcl_PushCallFrame to push p's namespace
  57. } {123}
  58. test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
  59.     namespace eval test_ns_1::baz {}  ;# does Tcl_PushCallFrame to create baz
  60.     proc test_ns_1::baz::p {} {
  61.         variable v
  62.         set v 789
  63.         set v}
  64.     test_ns_1::baz::p
  65. } {789}
  66.  
  67. test namespace-5.1 {Tcl_PopCallFrame, no vars} {
  68.     namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
  69. } {}
  70. test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
  71.     proc test_ns_1::r {} {
  72.         set a 123
  73.     }
  74.     test_ns_1::r   ;# pushes then pop's r's frame
  75. } {123}
  76.  
  77. test namespace-6.1 {Tcl_CreateNamespace} {
  78.     catch {eval namespace delete [namespace children :: test_ns_*]}
  79.     list [lsort [namespace children :: test_ns_*]] \
  80.      [namespace eval test_ns_1 {namespace current}] \
  81.      [namespace eval test_ns_2 {namespace current}] \
  82.      [namespace eval ::test_ns_3 {namespace current}] \
  83.      [namespace eval ::test_ns_4 \
  84.              {namespace eval foo {namespace current}}] \
  85.      [namespace eval ::test_ns_5 \
  86.              {namespace eval ::test_ns_6 {namespace current}}] \
  87.          [lsort [namespace children :: test_ns_*]]
  88. } {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}}
  89. test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
  90.     list [namespace eval :::test_ns_1::::foo {namespace current}] \
  91.          [namespace eval test_ns_2:::::foo {namespace current}]
  92. } {::test_ns_1::foo ::test_ns_2::foo}
  93. test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
  94.     list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 
  95. } {0 ::test_ns_7}
  96. test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
  97.     catch {eval namespace delete [namespace children :: test_ns_*]}
  98.     namespace eval test_ns_1:: {
  99.         namespace eval test_ns_2:: {}
  100.         namespace eval test_ns_3:: {}
  101.     }
  102.     namespace children ::test_ns_1
  103. } {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_3}
  104. test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in current ns} {
  105.     set trigger {
  106.         namespace eval test_ns_2 {namespace current}
  107.     }
  108.     set l {}
  109.     lappend l [namespace eval test_ns_1 $trigger]
  110.     namespace eval test_ns_1::test_ns_2 {}
  111.     lappend l [namespace eval test_ns_1 $trigger]
  112. } {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
  113.  
  114. test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
  115.     catch {eval namespace delete [namespace children :: test_ns_*]}
  116.     namespace eval test_ns_1 {
  117.         proc p {} {
  118.             namespace delete [namespace current]
  119.             return [namespace current]
  120.         }
  121.     }
  122.     list [test_ns_1::p] [catch {test_ns_1::p} msg] $msg
  123. } {::test_ns_1 1 {invalid command name "test_ns_1::p"}}
  124. test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
  125.     namespace eval test_ns_2 {
  126.         proc p {} {
  127.             return [namespace current]
  128.         }
  129.     }
  130.     list [test_ns_2::p] [namespace delete test_ns_2]
  131. } {::test_ns_2 {}}
  132.  
  133. test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
  134.     catch {interp delete test_interp}
  135.     interp create test_interp
  136.     interp eval test_interp {
  137.         namespace eval test_ns_1 {
  138.             namespace export p
  139.             proc p {} {
  140.                 return [namespace current]
  141.             }
  142.         }
  143.         namespace eval test_ns_2 {
  144.             namespace import ::test_ns_1::p
  145.             variable v 27
  146.             proc q {} {
  147.                 variable v
  148.                 return "[p] $v"
  149.             }
  150.         }
  151.         set x [test_ns_2::q]
  152.         catch {set xxxx}
  153.     }
  154.     list [interp eval test_interp {test_ns_2::q}] \
  155.          [interp eval test_interp {namespace delete ::}] \
  156.          [catch {interp eval test_interp {set a 123}} msg] $msg \
  157.          [interp delete test_interp]
  158. } {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
  159. test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
  160.     catch {eval namespace delete [namespace children :: test_ns_*]}
  161.     namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
  162.     namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
  163.     list [namespace children test_ns_1] \
  164.          [namespace delete test_ns_1::test_ns_2] \
  165.          [namespace children test_ns_1]
  166. } {::test_ns_1::test_ns_2 {} {}}
  167. test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
  168.     catch {eval namespace delete [namespace children :: test_ns_*]}
  169.     namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
  170.     namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
  171.     list [namespace children test_ns_1] \
  172.          [namespace delete test_ns_1::test_ns_2] \
  173.          [namespace children test_ns_1] \
  174.          [catch {namespace children test_ns_1::test_ns_2} msg] $msg \
  175.          [info commands test_ns_1::test_ns_2::test_ns_3a::*]
  176. } {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
  177. test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
  178.     catch {eval namespace delete [namespace children :: test_ns_*]}
  179.     namespace eval test_ns_export {
  180.         namespace export cmd1 cmd2
  181.         proc cmd1 {args} {return "cmd1: $args"}
  182.         proc cmd2 {args} {return "cmd2: $args"}
  183.     }
  184.     namespace eval test_ns_import {
  185.         namespace import ::test_ns_export::*
  186.         proc p {} {return foo}
  187.     }
  188.     list [info commands test_ns_import::*] \
  189.          [namespace delete test_ns_export] \
  190.          [info commands test_ns_import::*]
  191. } {{::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2} {} ::test_ns_import::p}
  192.  
  193. test namespace-9.1 {Tcl_Import, empty import pattern} {
  194.     catch {eval namespace delete [namespace children :: test_ns_*]}
  195.     list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
  196. } {1 {empty import pattern}}
  197. test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
  198.     list [catch {namespace eval test_ns_import {namespace import fred::x}} msg] $msg
  199. } {1 {unknown namespace in import pattern "fred::x"}}
  200. test namespace-9.3 {Tcl_Import, import ns == export ns} {
  201.     list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
  202. } {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
  203. test namespace-9.4 {Tcl_Import, simple import} {
  204.     catch {eval namespace delete [namespace children :: test_ns_*]}
  205.     namespace eval test_ns_export {
  206.         namespace export cmd1
  207.         proc cmd1 {args} {return "cmd1: $args"}
  208.         proc cmd2 {args} {return "cmd2: $args"}
  209.     }
  210.     namespace eval test_ns_import {
  211.         namespace import ::test_ns_export::*
  212.         proc p {} {return [cmd1 123]}
  213.     }
  214.     test_ns_import::p
  215. } {cmd1: 123}
  216. test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
  217.     list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
  218. } {1 {can't import command "cmd1": already exists}}
  219. test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
  220.     namespace eval test_ns_import {
  221.         namespace import -force ::test_ns_export::*
  222.         cmd1 555
  223.     }
  224. } {cmd1: 555}
  225.  
  226. test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
  227.     catch {eval namespace delete [namespace children :: test_ns_*]}
  228.     list [catch {namespace forget xyzzy::*} msg] $msg
  229. } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
  230. test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
  231.     namespace eval test_ns_export {
  232.         namespace export cmd1
  233.         proc cmd1 {args} {return "cmd1: $args"}
  234.         proc cmd2 {args} {return "cmd2: $args"}
  235.     }
  236.     namespace eval test_ns_import {
  237.         namespace forget ::test_ns_export::wombat
  238.     }
  239. } {}
  240. test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
  241.     namespace eval test_ns_import {
  242.         namespace import ::test_ns_export::*
  243.         proc p {} {return [cmd1 123]}
  244.         set l {}
  245.         lappend l [info commands ::test_ns_import::*]
  246.         namespace forget ::test_ns_export::cmd1
  247.         lappend l [info commands ::test_ns_import::*]
  248.         lappend l [catch {cmd1 777} msg] $msg
  249.     }
  250. } {{::test_ns_import::p ::test_ns_import::cmd1} ::test_ns_import::p 1 {invalid command name "cmd1"}}
  251.  
  252. test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
  253.     catch {eval namespace delete [namespace children :: test_ns_*]}
  254.     namespace eval test_ns_export {
  255.         namespace export cmd1
  256.         proc cmd1 {args} {return "cmd1: $args"}
  257.     }
  258.     list [namespace origin set] [namespace origin test_ns_export::cmd1]
  259. } {::set ::test_ns_export::cmd1}
  260. test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
  261.     namespace eval test_ns_import1 {
  262.         namespace import ::test_ns_export::*
  263.         namespace export *
  264.         proc p {} {namespace origin cmd1}
  265.     }
  266.     list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
  267. } {::test_ns_export::cmd1 ::test_ns_export::cmd1}
  268. test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
  269.     namespace eval test_ns_import2 {
  270.         namespace import ::test_ns_import1::*
  271.         proc q {} {return [cmd1 123]}
  272.     }
  273.     list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
  274. } {{cmd1: 123} ::test_ns_export::cmd1}
  275.  
  276. test namespace-12.1 {InvokeImportedCmd} {
  277.     catch {eval namespace delete [namespace children :: test_ns_*]}
  278.     namespace eval test_ns_export {
  279.         namespace export cmd1
  280.         proc cmd1 {args} {namespace current}
  281.     }
  282.     namespace eval test_ns_import {
  283.         namespace import ::test_ns_export::*
  284.     }
  285.     list [test_ns_import::cmd1]
  286. } {::test_ns_export}
  287.  
  288. test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
  289.     namespace eval test_ns_import {
  290.         set l {}
  291.         lappend l [info commands ::test_ns_import::*]
  292.         namespace forget ::test_ns_export::cmd1
  293.         lappend l [info commands ::test_ns_import::*]
  294.     }
  295. } {::test_ns_import::cmd1 {}}
  296.  
  297. test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
  298.     catch {eval namespace delete [namespace children :: test_ns_*]}
  299.     variable v 10
  300.     namespace eval test_ns_1::test_ns_2 {
  301.         variable v 20
  302.     }
  303.     namespace eval test_ns_2 {
  304.         variable v 30
  305.     }
  306.     namespace eval test_ns_1 {
  307.         list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
  308.              [namespace children :: test_ns_*]
  309.     }
  310. } {10 30 20 {::test_ns_1 ::test_ns_2}}
  311. test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
  312.     namespace eval test_ns_1 {
  313.         list [catch {set ::test_ns_777::v} msg] $msg \
  314.              [catch {namespace children test_ns_777} msg] $msg
  315.     }
  316. } {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
  317. test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
  318.     namespace eval test_ns_1 {
  319.         list $v $test_ns_2::v
  320.     }
  321. } {10 20}
  322. test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
  323.     namespace eval test_ns_1::test_ns_2 {
  324.         namespace eval foo {}
  325.     }
  326.     namespace eval test_ns_1 {
  327.         list [namespace children test_ns_2] \
  328.              [catch {namespace children test_ns_1} msg] $msg
  329.     }
  330. } {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
  331. test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
  332.     namespace eval ::test_ns_2 {
  333.         namespace eval bar {}
  334.     }
  335.     namespace eval test_ns_1 {
  336.         set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
  337.     }
  338.     set l
  339. } {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
  340. test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
  341.     namespace eval test_ns_1::test_ns_2 {
  342.         namespace eval foo {}
  343.     }
  344.     namespace eval test_ns_1 {
  345.         list [namespace children test_ns_2] \
  346.              [catch {namespace children test_ns_1} msg] $msg
  347.     }
  348. } {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
  349. test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
  350.     namespace children test_ns_1:::
  351. } {::test_ns_1::test_ns_2}
  352. test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
  353.     namespace children :::test_ns_1:::::test_ns_2:::
  354. } {::test_ns_1::test_ns_2::foo}
  355. test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
  356.     set l {}
  357.     lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
  358.     namespace eval test_ns_1::test_ns_2 {variable {} 2525}
  359.     lappend l [set test_ns_1::test_ns_2::]
  360. } {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
  361. test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
  362.     catch {unset test_ns_1::test_ns_2::}
  363.     set l {}
  364.     lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
  365.     set test_ns_1::test_ns_2:: 314159
  366.     lappend l [set test_ns_1::test_ns_2::]
  367. } {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
  368. test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
  369.     catch {rename test_ns_1::test_ns_2:: {}}
  370.     set l {}
  371.     lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
  372.     proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
  373.     lappend l [test_ns_1::test_ns_2:: hello]
  374. } {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
  375. test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
  376.     catch {eval namespace delete [namespace children :: test_ns_*]}
  377.     namespace eval test_ns_1 {
  378.         variable {}
  379.         set test_ns_1::(x) y
  380.     }
  381.     set test_ns_1::(x)
  382. } y
  383. test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
  384.     catch {eval namespace delete [namespace children :: test_ns_*]}
  385.     list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
  386. } {1 {can't create namespace "": only global namespace can have empty name}}
  387.  
  388. test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
  389.     catch {eval namespace delete [namespace children :: test_ns_*]}
  390.     namespace eval test_ns_delete {
  391.         namespace eval test_ns_delete2 {}
  392.         proc cmd {args} {namespace current}
  393.     }
  394.     list [namespace delete ::test_ns_delete::test_ns_delete2] \
  395.          [namespace children ::test_ns_delete]
  396. } {{} {}}
  397. test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
  398.     list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
  399. } {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
  400. test namespace-15.3 {Tcl_FindNamespace, relative name found} {
  401.     namespace eval test_ns_delete {
  402.         namespace eval test_ns_delete2 {}
  403.         namespace eval test_ns_delete3 {}
  404.         list [namespace delete test_ns_delete2] \
  405.              [namespace children [namespace current]]
  406.     }
  407. } {{} ::test_ns_delete::test_ns_delete3}
  408. test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
  409.     namespace eval test_ns_delete2 {}
  410.     namespace eval test_ns_delete {
  411.         list [catch {namespace delete test_ns_delete2} msg] $msg
  412.     }
  413. } {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
  414.  
  415. test namespace-16.1 {Tcl_FindCommand, absolute name found} {
  416.     catch {eval namespace delete [namespace children :: test_ns_*]}
  417.     namespace eval test_ns_1 {
  418.         proc cmd {args} {return "[namespace current]::cmd: $args"}
  419.         variable v "::test_ns_1::cmd"
  420.         eval $v one
  421.     }
  422. } {::test_ns_1::cmd: one}
  423. test namespace-16.2 {Tcl_FindCommand, absolute name found} {
  424.     eval $test_ns_1::v two
  425. } {::test_ns_1::cmd: two}
  426. test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
  427.     namespace eval test_ns_1 {
  428.         variable v2 "::test_ns_1::ladidah"
  429.         list [catch {eval $v2} msg] $msg
  430.     }
  431. } {1 {invalid command name "::test_ns_1::ladidah"}}
  432.  
  433. # save the "unknown" proc, which is redefined by the following two tests
  434. catch {rename unknown unknown.old}
  435. proc unknown {args} {
  436.     return "unknown: $args"
  437. }
  438. test namespace-16.4 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
  439.     ::test_ns_1::foobar x y z
  440. } {unknown: ::test_ns_1::foobar x y z}
  441. test namespace-16.5 {Tcl_FindCommand, absolute name and TCL_GLOBAL_ONLY} {
  442.     ::foobar 1 2 3 4 5
  443. } {unknown: ::foobar 1 2 3 4 5}
  444. test namespace-16.6 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
  445.     test_ns_1::foobar x y z
  446. } {unknown: test_ns_1::foobar x y z}
  447. test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
  448.     foobar 1 2 3 4 5
  449. } {unknown: foobar 1 2 3 4 5}
  450. # restore the "unknown" proc saved previously
  451. catch {rename unknown {}}
  452. catch {rename unknown.old unknown}
  453.  
  454. test namespace-16.8 {Tcl_FindCommand, relative name found} {
  455.     namespace eval test_ns_1 {
  456.         cmd a b c
  457.     }
  458. } {::test_ns_1::cmd: a b c}
  459. test namespace-16.9 {Tcl_FindCommand, relative name found} {
  460.     catch {rename cmd2 {}}
  461.     proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
  462.     namespace eval test_ns_1 {
  463.        cmd2 a b c
  464.     }
  465. } {::::cmd2: a b c}
  466. test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
  467.     namespace eval test_ns_1 {
  468.         proc cmd2 {args} {
  469.             return "[namespace current]::cmd2 in test_ns_1: $args"
  470.         }
  471.         namespace eval test_ns_12 {
  472.             cmd2 a b c
  473.         }
  474.     }
  475. } {::::cmd2: a b c}
  476. test namespace-16.11 {Tcl_FindCommand, relative name not found} {
  477.     namespace eval test_ns_1 {
  478.        list [catch {cmd3 a b c} msg] $msg
  479.     }
  480. } {1 {invalid command name "cmd3"}}
  481.  
  482. catch {unset x}
  483. test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
  484.     catch {eval namespace delete [namespace children :: test_ns_*]}
  485.     set x 314159
  486.     namespace eval test_ns_1 {
  487.         set ::x
  488.     }
  489. } {314159}
  490. test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
  491.     namespace eval test_ns_1 {
  492.         variable x 777
  493.         set ::test_ns_1::x
  494.     }
  495. } {777}
  496. test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
  497.     namespace eval test_ns_1 {
  498.         namespace eval test_ns_2 {
  499.             variable x 1111
  500.         }
  501.         set ::test_ns_1::test_ns_2::x
  502.     }
  503. } {1111}
  504. test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
  505.     namespace eval test_ns_1 {
  506.         namespace eval test_ns_2 {
  507.             variable x 1111
  508.         }
  509.         list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
  510.     }
  511. } {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
  512. test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
  513.     namespace eval test_ns_1 {
  514.         namespace eval test_ns_3 {
  515.             variable ::test_ns_1::test_ns_2::x 2222
  516.         }
  517.     }
  518.     set ::test_ns_1::test_ns_2::x
  519. } {2222}
  520. test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
  521.     namespace eval test_ns_1 {
  522.         set x
  523.     }
  524. } {777}
  525. test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
  526.     namespace eval test_ns_1 {
  527.         unset x
  528.         set x  ;# must be global x now
  529.     }
  530. } {314159}
  531. test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
  532.     namespace eval test_ns_1 {
  533.         list [catch {set wuzzat} msg] $msg
  534.     }
  535. } {1 {can't read "wuzzat": no such variable}}
  536. test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
  537.     namespace eval test_ns_1 {
  538.         variable a hello
  539.     }
  540.     set test_ns_1::a
  541. } {hello}
  542. catch {unset x}
  543.  
  544. catch {unset l}
  545. catch {rename foo {}}
  546. test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
  547.     catch {eval namespace delete [namespace children :: test_ns_*]}
  548.     proc foo {} {return "global foo"}
  549.     namespace eval test_ns_1 {
  550.         proc trigger {} {
  551.             return [foo]
  552.         }
  553.     }
  554.     set l ""
  555.     lappend l [test_ns_1::trigger]
  556.     namespace eval test_ns_1 {
  557.         # force invalidation of cached ref to "foo" in proc trigger
  558.         proc foo {} {return "foo in test_ns_1"}
  559.     }
  560.     lappend l [test_ns_1::trigger]
  561.     set l
  562. } {{global foo} {foo in test_ns_1}}
  563. test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
  564.     namespace eval test_ns_2 {
  565.         proc foo {} {return "foo in ::test_ns_2"}
  566.     }
  567.     namespace eval test_ns_1 {
  568.         namespace eval test_ns_2 {}
  569.         proc trigger {} {
  570.             return [test_ns_2::foo]
  571.         }
  572.     }
  573.     set l ""
  574.     lappend l [test_ns_1::trigger]
  575.     namespace eval test_ns_1 {
  576.         namespace eval test_ns_2 {
  577.             # force invalidation of cached ref to "foo" in proc trigger
  578.             proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
  579.         }
  580.     }
  581.     lappend l [test_ns_1::trigger]
  582.     set l
  583. } {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
  584. catch {unset l}
  585. catch {rename foo {}}
  586.  
  587. test namespace-19.1 {GetNamespaceFromObj, global name found} {
  588.     catch {eval namespace delete [namespace children :: test_ns_*]}
  589.     namespace eval test_ns_1::test_ns_2 {}
  590.     namespace children ::test_ns_1
  591. } {::test_ns_1::test_ns_2}
  592. test namespace-19.2 {GetNamespaceFromObj, relative name found} {
  593.     namespace eval test_ns_1 {
  594.         namespace children test_ns_2
  595.     }
  596. } {}
  597. test namespace-19.3 {GetNamespaceFromObj, name not found} {
  598.     namespace eval test_ns_1 {
  599.         list [catch {namespace children test_ns_99} msg] $msg
  600.     }
  601. } {1 {unknown namespace "test_ns_99" in namespace children command}}
  602. test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
  603.     namespace eval test_ns_1 {
  604.         proc foo {} {
  605.             return [namespace children test_ns_2]
  606.         }
  607.         list [catch {namespace children test_ns_99} msg] $msg
  608.     }
  609.     set l {}
  610.     lappend l [test_ns_1::foo]
  611.     namespace delete test_ns_1::test_ns_2
  612.     namespace eval test_ns_1::test_ns_2::test_ns_3 {}
  613.     lappend l [test_ns_1::foo]
  614.     set l
  615. } {{} ::test_ns_1::test_ns_2::test_ns_3}
  616.  
  617. test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
  618.     catch {eval namespace delete [namespace children :: test_ns_*]}
  619.     list [catch {namespace} msg] $msg
  620. } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
  621. test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
  622.     list [catch {namespace wombat {}} msg] $msg
  623. } {1 {bad option "wombat": must be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
  624. test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
  625.     namespace ch :: test_ns_*
  626. } {}
  627.  
  628. test namespace-21.1 {NamespaceChildrenCmd, no args} {
  629.     catch {eval namespace delete [namespace children :: test_ns_*]}
  630.     namespace eval test_ns_1::test_ns_2 {}
  631.     expr {[string first ::test_ns_1 [namespace children]] != -1}
  632. } {1}
  633. test namespace-21.2 {NamespaceChildrenCmd, no args} {
  634.     namespace eval test_ns_1 {
  635.         namespace children
  636.     }
  637. } {::test_ns_1::test_ns_2}
  638. test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
  639.     namespace children ::test_ns_1
  640. } {::test_ns_1::test_ns_2}
  641. test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
  642.     namespace eval test_ns_1 {
  643.         namespace children test_ns_2
  644.     }
  645. } {}
  646. test namespace-21.5 {NamespaceChildrenCmd, too many args} {
  647.     namespace eval test_ns_1 {
  648.         list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
  649.     }
  650. } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
  651. test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
  652.     namespace eval test_ns_1::test_ns_foo {}
  653.     namespace children test_ns_1 *f*
  654. } {::test_ns_1::test_ns_foo}
  655. test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
  656.     namespace eval test_ns_1::test_ns_foo {}
  657.     namespace children test_ns_1 test*
  658. } {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
  659.  
  660. test namespace-22.1 {NamespaceCodeCmd, bad args} {
  661.     catch {eval namespace delete [namespace children :: test_ns_*]}
  662.     list [catch {namespace code} msg] $msg \
  663.          [catch {namespace code xxx yyy} msg] $msg
  664. } {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
  665. test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
  666.     namespace eval test_ns_1 {
  667.         proc cmd {} {return "test_ns_1::cmd"}
  668.     }
  669.     namespace code {namespace inscope ::test_ns_1 cmd}
  670. } {namespace inscope ::test_ns_1 cmd}
  671. test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
  672.     namespace code {namespace     inscope     ::test_ns_1 cmd}
  673. } {namespace     inscope     ::test_ns_1 cmd}
  674. test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
  675.     namespace code unknown
  676. } {namespace inscope :: unknown}
  677. test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
  678.     namespace eval test_ns_1 {
  679.         namespace code cmd
  680.     }
  681. } {namespace inscope ::test_ns_1 cmd}
  682.  
  683. test namespace-23.1 {NamespaceCurrentCmd, bad args} {
  684.     catch {eval namespace delete [namespace children :: test_ns_*]}
  685.     list [catch {namespace current xxx} msg] $msg \
  686.          [catch {namespace current xxx yyy} msg] $msg
  687. } {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
  688. test namespace-23.2 {NamespaceCurrentCmd, at global level} {
  689.     namespace current
  690. } {::}
  691. test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
  692.     namespace eval test_ns_1::test_ns_2 {
  693.         namespace current
  694.     }
  695. } {::test_ns_1::test_ns_2}
  696.  
  697. test namespace-24.1 {NamespaceDeleteCmd, no args} {
  698.     catch {eval namespace delete [namespace children :: test_ns_*]}
  699.     namespace delete
  700. } {}
  701. test namespace-24.2 {NamespaceDeleteCmd, one arg} {
  702.     namespace eval test_ns_1::test_ns_2 {}
  703.     namespace delete ::test_ns_1
  704. } {}
  705. test namespace-24.3 {NamespaceDeleteCmd, two args} {
  706.     namespace eval test_ns_1::test_ns_2 {}
  707.     list [namespace delete ::test_ns_1::test_ns_2] [namespace delete ::test_ns_1]
  708. } {{} {}}
  709. test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
  710.     list [catch {namespace delete ::test_ns_foo} msg] $msg
  711. } {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
  712.  
  713. test namespace-25.1 {NamespaceEvalCmd, bad args} {
  714.     catch {eval namespace delete [namespace children :: test_ns_*]}
  715.     list [catch {namespace eval} msg] $msg
  716. } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
  717. test namespace-25.2 {NamespaceEvalCmd, bad args} {
  718.     list [catch {namespace test_ns_1} msg] $msg
  719. } {1 {bad option "test_ns_1": must be children, code, current, delete, eval, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}}
  720. catch {unset v}
  721. test namespace-25.3 {NamespaceEvalCmd, new namespace} {
  722.     set v 123
  723.     namespace eval test_ns_1 {
  724.         variable v 314159
  725.         proc p {} {
  726.             variable v
  727.             return $v
  728.         }
  729.     }
  730.     test_ns_1::p
  731. } {314159}
  732. test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
  733.     namespace eval test_ns_1 {
  734.         proc q {} {return [expr {[p]+1}]}
  735.     }
  736.     test_ns_1::q
  737. } {314160}
  738. test namespace-25.5 {NamespaceEvalCmd, multiple args} {
  739.     namespace eval test_ns_1 "set" "v"
  740. } {314159}
  741. test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
  742.     list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
  743. } {1 {invalid command name "xxxx"} {invalid command name "xxxx"
  744.     while executing
  745. "xxxx"
  746.     (in namespace eval "::test_ns_1" script line 1)
  747.     invoked from within
  748. "namespace eval test_ns_1 {xxxx}"}}
  749. catch {unset v}
  750.  
  751. test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
  752.     catch {eval namespace delete [namespace children :: test_ns_*]}
  753.     namespace export
  754. } {}
  755. test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
  756.     namespace export -clear
  757. } {}
  758. test namespace-26.3 {NamespaceExportCmd, pattern can't specify a namespace} {
  759.     namespace eval test_ns_1 {
  760.         list [catch {namespace export ::zzz} msg] $msg
  761.     }
  762. } {1 {invalid export pattern "::zzz": pattern can't specify a namespace}}
  763. test namespace-26.4 {NamespaceExportCmd, one pattern} {
  764.     namespace eval test_ns_1 {
  765.         namespace export cmd1
  766.         proc cmd1 {args} {return "cmd1: $args"}
  767.         proc cmd2 {args} {return "cmd2: $args"}
  768.         proc cmd3 {args} {return "cmd3: $args"}
  769.         proc cmd4 {args} {return "cmd4: $args"}
  770.     }
  771.     namespace eval test_ns_2 {
  772.         namespace import ::test_ns_1::*
  773.     }
  774.     list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
  775. } {::test_ns_2::cmd1 {cmd1: hello}}
  776. test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
  777.     namespace eval test_ns_1 {
  778.         namespace export cmd1 cmd3
  779.     }
  780.     namespace eval test_ns_2 {
  781.         namespace import -force ::test_ns_1::*
  782.     }
  783.     list [info commands test_ns_2::*] [test_ns_2::cmd3 hello]
  784. } {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
  785. test namespace-26.6 {NamespaceExportCmd, no patterns means return export list} {
  786.     namespace eval test_ns_1 {
  787.         namespace export
  788.     }
  789. } {cmd1 cmd1 cmd3}
  790. test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
  791.     namespace eval test_ns_1 {
  792.         namespace export -clear cmd4
  793.     }
  794.     namespace eval test_ns_2 {
  795.         namespace import ::test_ns_1::*
  796.     }
  797.     list [info commands test_ns_2::*] [test_ns_2::cmd4 hello]
  798. } {{::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd4: hello}}
  799.  
  800. test namespace-27.1 {NamespaceForgetCmd, no args} {
  801.     catch {eval namespace delete [namespace children :: test_ns_*]}
  802.     namespace forget
  803. } {}
  804. test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
  805.     list [catch {namespace forget ::test_ns_1::xxx} msg] $msg
  806. } {1 {unknown namespace in namespace forget pattern "::test_ns_1::xxx"}}
  807. test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
  808.     namespace eval test_ns_1 {
  809.         namespace export cmd*
  810.         proc cmd1 {args} {return "cmd1: $args"}
  811.         proc cmd2 {args} {return "cmd2: $args"}
  812.     }
  813.     namespace eval test_ns_2 {
  814.         namespace import ::test_ns_1::*
  815.         namespace forget ::test_ns_1::cmd1
  816.     }
  817.     info commands ::test_ns_2::*
  818. } {::test_ns_2::cmd2}
  819.  
  820. test namespace-28.1 {NamespaceImportCmd, no args} {
  821.     catch {eval namespace delete [namespace children :: test_ns_*]}
  822.     namespace import
  823. } {}
  824. test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
  825.     namespace import -force
  826. } {}
  827. test namespace-28.3 {NamespaceImportCmd, arg is imported} {
  828.     namespace eval test_ns_1 {
  829.         namespace export cmd2
  830.         proc cmd1 {args} {return "cmd1: $args"}
  831.         proc cmd2 {args} {return "cmd2: $args"}
  832.     }
  833.     namespace eval test_ns_2 {
  834.         namespace import ::test_ns_1::*
  835.         namespace forget ::test_ns_1::cmd1
  836.     }
  837.     info commands test_ns_2::*
  838. } {::test_ns_2::cmd2}
  839.  
  840. test namespace-29.1 {NamespaceInscopeCmd, bad args} {
  841.     catch {eval namespace delete [namespace children :: test_ns_*]}
  842.     list [catch {namespace inscope} msg] $msg
  843. } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
  844. test namespace-29.2 {NamespaceInscopeCmd, bad args} {
  845.     list [catch {namespace inscope ::} msg] $msg
  846. } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
  847. test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
  848.     list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
  849. } {1 {unknown namespace "test_ns_1" in inscope namespace command}}
  850. test namespace-29.4 {NamespaceInscopeCmd, simple case} {
  851.     namespace eval test_ns_1 {
  852.         variable v 747
  853.         proc cmd {args} {
  854.             variable v
  855.             return "[namespace current]::cmd: v=$v, args=$args"
  856.         }
  857.     }
  858.     namespace inscope test_ns_1 cmd
  859. } {::test_ns_1::cmd: v=747, args=}
  860. test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
  861.     list [namespace inscope test_ns_1 cmd x y z] \
  862.          [namespace eval test_ns_1 [concat cmd [list x y z]]]
  863. } {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
  864.  
  865. test namespace-30.1 {NamespaceOriginCmd, bad args} {
  866.     catch {eval namespace delete [namespace children :: test_ns_*]}
  867.     list [catch {namespace origin} msg] $msg
  868. } {1 {wrong # args: should be "namespace origin name"}}
  869. test namespace-30.2 {NamespaceOriginCmd, bad args} {
  870.     list [catch {namespace origin x y} msg] $msg
  871. } {1 {wrong # args: should be "namespace origin name"}}
  872. test namespace-30.3 {NamespaceOriginCmd, command not found} {
  873.     list [catch {namespace origin fred} msg] $msg
  874. } {1 {invalid command name "fred"}}
  875. test namespace-30.4 {NamespaceOriginCmd, command isn't imported} {
  876.     namespace origin set
  877. } {::set}
  878. test namespace-30.5 {NamespaceOriginCmd, imported command} {
  879.     namespace eval test_ns_1 {
  880.         namespace export cmd*
  881.         proc cmd1 {args} {return "cmd1: $args"}
  882.         proc cmd2 {args} {return "cmd2: $args"}
  883.     }
  884.     namespace eval test_ns_2 {
  885.         namespace export *
  886.         namespace import ::test_ns_1::*
  887.         proc p {} {}
  888.     }
  889.     namespace eval test_ns_3 {
  890.         namespace import ::test_ns_2::*
  891.         list [namespace origin foreach] \
  892.              [namespace origin p] \
  893.              [namespace origin cmd1] \
  894.              [namespace origin ::test_ns_2::cmd2]
  895.     }
  896. } {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
  897.  
  898. test namespace-31.1 {NamespaceParentCmd, bad args} {
  899.     catch {eval namespace delete [namespace children :: test_ns_*]}
  900.     list [catch {namespace parent a b} msg] $msg
  901. } {1 {wrong # args: should be "namespace parent ?name?"}}
  902. test namespace-31.2 {NamespaceParentCmd, no args} {
  903.     namespace parent
  904. } {}
  905. test namespace-31.3 {NamespaceParentCmd, namespace specified} {
  906.     namespace eval test_ns_1 {
  907.         namespace eval test_ns_2 {
  908.             namespace eval test_ns_3 {}
  909.         }
  910.     }
  911.     list [namespace parent ::] \
  912.          [namespace parent test_ns_1::test_ns_2] \
  913.          [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
  914. } {{} ::test_ns_1 ::test_ns_1}
  915. test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
  916.     list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
  917. } {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
  918.  
  919. test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
  920.     catch {eval namespace delete [namespace children :: test_ns_*]}
  921.     list [catch {namespace qualifiers} msg] $msg
  922. } {1 {wrong # args: should be "namespace qualifiers string"}}
  923. test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
  924.     list [catch {namespace qualifiers x y} msg] $msg
  925. } {1 {wrong # args: should be "namespace qualifiers string"}}
  926. test namespace-32.3 {NamespaceQualifiersCmd, simple name} {
  927.     namespace qualifiers foo
  928. } {}
  929. test namespace-32.4 {NamespaceQualifiersCmd, leading ::} {
  930.     namespace qualifiers ::x::y::z
  931. } {::x::y}
  932. test namespace-32.5 {NamespaceQualifiersCmd, no leading ::} {
  933.     namespace qualifiers a::b
  934. } {a}
  935. test namespace-32.6 {NamespaceQualifiersCmd, :: argument} {
  936.     namespace qualifiers ::
  937. } {}
  938. test namespace-32.7 {NamespaceQualifiersCmd, odd number of :s} {
  939.     namespace qualifiers :::::
  940. } {}
  941. test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
  942.     namespace qualifiers foo:::
  943. } {foo}
  944.  
  945. test namespace-33.1 {NamespaceTailCmd, bad args} {
  946.     catch {eval namespace delete [namespace children :: test_ns_*]}
  947.     list [catch {namespace tail} msg] $msg
  948. } {1 {wrong # args: should be "namespace tail string"}}
  949. test namespace-33.2 {NamespaceTailCmd, bad args} {
  950.     list [catch {namespace tail x y} msg] $msg
  951. } {1 {wrong # args: should be "namespace tail string"}}
  952. test namespace-33.3 {NamespaceTailCmd, simple name} {
  953.     namespace tail foo
  954. } {foo}
  955. test namespace-33.4 {NamespaceTailCmd, leading ::} {
  956.     namespace tail ::x::y::z
  957. } {z}
  958. test namespace-33.5 {NamespaceTailCmd, no leading ::} {
  959.     namespace tail a::b
  960. } {b}
  961. test namespace-33.6 {NamespaceTailCmd, :: argument} {
  962.     namespace tail ::
  963. } {}
  964. test namespace-33.7 {NamespaceTailCmd, odd number of :s} {
  965.     namespace tail :::::
  966. } {}
  967. test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
  968.     namespace tail foo:::
  969. } {}
  970.  
  971. test namespace-34.1 {NamespaceWhichCmd, bad args} {
  972.     catch {eval namespace delete [namespace children :: test_ns_*]}
  973.     list [catch {namespace which} msg] $msg
  974. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  975. test namespace-34.2 {NamespaceWhichCmd, bad args} {
  976.     list [catch {namespace which -fred} msg] $msg
  977. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  978. test namespace-34.3 {NamespaceWhichCmd, bad args} {
  979.     list [catch {namespace which -command} msg] $msg
  980. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  981. test namespace-34.4 {NamespaceWhichCmd, bad args} {
  982.     list [catch {namespace which a b} msg] $msg
  983. } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
  984. test namespace-34.5 {NamespaceWhichCmd, command lookup} {
  985.     namespace eval test_ns_1 {
  986.         namespace export cmd*
  987.         variable v1 111
  988.         proc cmd1 {args} {return "cmd1: $args"}
  989.         proc cmd2 {args} {return "cmd2: $args"}
  990.     }
  991.     namespace eval test_ns_2 {
  992.         namespace export *
  993.         namespace import ::test_ns_1::*
  994.         variable v2 222
  995.         proc p {} {}
  996.     }
  997.     namespace eval test_ns_3 {
  998.         namespace import ::test_ns_2::*
  999.         variable v3 333
  1000.         list [namespace which -command foreach] \
  1001.              [namespace which -command p] \
  1002.              [namespace which -command cmd1] \
  1003.              [namespace which -command ::test_ns_2::cmd2] \
  1004.              [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
  1005.     }
  1006. } {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
  1007. test namespace-34.6 {NamespaceWhichCmd, -command is default} {
  1008.     namespace eval test_ns_3 {
  1009.         list [namespace which foreach] \
  1010.              [namespace which p] \
  1011.              [namespace which cmd1] \
  1012.              [namespace which ::test_ns_2::cmd2]
  1013.     }
  1014. } {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
  1015. test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
  1016.     namespace eval test_ns_3 {
  1017.         list [namespace which -variable env] \
  1018.              [namespace which -variable v3] \
  1019.              [namespace which -variable ::test_ns_2::v2] \
  1020.              [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
  1021.     }
  1022. } {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
  1023.  
  1024. test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
  1025.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1026.     namespace eval test_ns_1 {
  1027.         proc p {} {
  1028.             namespace delete [namespace current]
  1029.             return [namespace current]
  1030.         }
  1031.     }
  1032.     test_ns_1::p
  1033. } {::test_ns_1}
  1034. test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
  1035.     namespace eval test_ns_1 {
  1036.         proc q {} {
  1037.             return [namespace current]
  1038.         }
  1039.     }
  1040.     list [test_ns_1::q] \
  1041.          [namespace delete test_ns_1] \
  1042.          [catch {test_ns_1::q} msg] $msg
  1043. } {::test_ns_1 {} 1 {invalid command name "test_ns_1::q"}}
  1044.  
  1045. catch {unset x}
  1046. catch {unset y}
  1047. test namespace-36.1 {DupNsNameInternalRep} {
  1048.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1049.     namespace eval test_ns_1 {}
  1050.     set x "::test_ns_1"
  1051.     list [namespace parent $x] [set y $x] [namespace parent $y]
  1052. } {:: ::test_ns_1 ::}
  1053. catch {unset x}
  1054. catch {unset y}
  1055.  
  1056. test namespace-37.1 {SetNsNameFromAny, ns name found} {
  1057.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1058.     namespace eval test_ns_1::test_ns_2 {}
  1059.     namespace eval test_ns_1 {
  1060.         namespace children ::test_ns_1
  1061.     }
  1062. } {::test_ns_1::test_ns_2}
  1063. test namespace-37.2 {SetNsNameFromAny, ns name not found} {
  1064.     namespace eval test_ns_1 {
  1065.         list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
  1066.     }
  1067. } {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
  1068.  
  1069. test namespace-38.1 {UpdateStringOfNsName} {
  1070.     catch {eval namespace delete [namespace children :: test_ns_*]}
  1071.     ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
  1072.     list [namespace eval {} {namespace current}] \
  1073.          [namespace eval {} {namespace current}]
  1074. } {:: ::}
  1075.  
  1076. catch {rename cmd1 {}}
  1077. catch {unset l}
  1078. catch {unset msg}
  1079. catch {unset trigger}
  1080. eval namespace delete [namespace children :: test_ns_*]
  1081.